home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / opers.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  5.8 KB  |  178 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module opers)
  13.  
  14. ;; This file is the run-time half of the OPERS package, an interface to the
  15. ;; Macsyma general representation simplifier.  When new expressions are being
  16. ;; created, the functions in this file or the macros in MOPERS should be called
  17. ;; rather than the entrypoints in SIMP such as SIMPLIFYA or SIMPLUS.  Many of
  18. ;; the functions in this file will do a pre-simplification to prevent
  19. ;; unnecessary consing. [Of course, this is really the "wrong" thing, since
  20. ;; knowledge about 0 being the additive identity of the reals is now
  21. ;; kept in two different places.]
  22.  
  23. ;; The basic functions in the virtual interface are ADD, SUB, MUL, DIV, POWER,
  24. ;; NCMUL, NCPOWER, NEG, INV.  Each of these functions assume that their
  25. ;; arguments are simplified.  Some functions will have a "*" adjoined to the
  26. ;; end of the name (as in ADD*).  These do not assume that their arguments are
  27. ;; simplified.  In addition, there are a few entrypoints such as ADDN, MULN
  28. ;; which take a list of terms as a first argument, and a simplification flag as
  29. ;; the second argument.  The above functions are the only entrypoints to this
  30. ;; package.
  31.  
  32. ;; The functions ADD2, ADD2*, MUL2, MUL2*, and MUL3 are for use internal to
  33. ;; this package and should not be called externally.  Note that MOPERS is
  34. ;; needed to compile this file.
  35.  
  36. ;; Addition primitives.
  37. #-cl
  38. (defmfun add2 (x y)
  39.   (cond
  40.     ((=0 x) y)
  41.     ((=0 y) x)
  42.     (t (simplifya `((mplus) ,x ,y) t))))
  43.  
  44. #+cl
  45. (defmfun add2 (x y)
  46.   (cond ((numberp x)
  47.     (cond ((numberp y) (+ x y))
  48.           ((zerop x) y)
  49.           (t (simplifya `((mplus) ,x ,y) t))))
  50.     ((eql y 0) x)
  51.     (t (simplifya `((mplus) ,x ,y) t))))
  52.  
  53. (defmfun add2* (x y)
  54.   (cond
  55.     #+cl ((and (numberp x) (numberp y)) (+ x y))
  56.     ((=0 x) (simplifya y nil))
  57.     ((=0 y) (simplifya x nil))
  58.     (t (simplifya `((mplus) ,x ,y) nil))))
  59.  
  60. ;; The first two cases in this cond shouldn't be needed, but exist
  61. ;; for compatibility with the old OPERS package.  The old ADDLIS
  62. ;; deleted zeros ahead of time.  Is this worth it?
  63.  
  64. (defmfun addn (terms simp-flag)
  65.   (cond ((null terms) 0)
  66.     (t (simplifya `((mplus) . ,terms) simp-flag))))
  67.  
  68. (declare-top (special $negdistrib) (muzzled t))
  69.  
  70. (defmfun neg (x)
  71.   (cond ((numberp x) (minus x))
  72.     (t (let (($negdistrib t))
  73.         (simplifya `((mtimes) -1 ,x) t)))))
  74.  
  75. (declare-top (muzzled nil))
  76.  
  77. (defmfun sub (x y)
  78.   (cond
  79.     #+cl ((and (numberp x) (numberp y)) (- x y))
  80.     ((=0 y) x)
  81.     ((=0 x) (neg y))
  82.     (t (add x (neg y)))))
  83. #+cl
  84. (defmfun sub* (x y)
  85.   (cond
  86.     ((and (numberp x) (numberp y)) (- x y))
  87.     ((=0 y) x)
  88.     ((=0 x) (neg y))
  89.     (t
  90.      (add (simplifya x nil) (mul -1 (simplifya y nil))))))
  91. #-cl
  92. (defmfun sub* (x y)
  93.      (add (simplifya x nil) (mul -1 (simplifya y nil))))
  94.  
  95. ;; Multiplication primitives -- is it worthwhile to handle the 3-arg
  96. ;; case specially?  Don't simplify x*0 --> 0 since x could be non-scalar.
  97.  
  98. (defmfun mul2 (x y)
  99.   (cond    
  100.     #+cl ((and (numberp x) (numberp y)) (* x y))
  101.     ((=1 x) y)
  102.     ((=1 y) x)
  103.     (t (simplifya `((mtimes) ,x ,y) t))))
  104.  
  105. (defmfun mul2* (x y)
  106.   
  107.   (cond
  108.     #+cl ((and (numberp x) (numberp y)) (f* x y))
  109.     ((=1 x) (simplifya y nil))
  110.     ((=1 y) (simplifya x nil))
  111.     (t (simplifya `((mtimes) ,x ,y) nil))))
  112.  
  113. (defmfun mul3 (x y z)
  114.   (cond ((=1 x) (mul2 y z))
  115.     ((=1 y) (mul2 x z))
  116.     ((=1 z) (mul2 x y))
  117.     (t (simplifya `((mtimes) ,x ,y ,z) t))))
  118.  
  119. ;; The first two cases in this cond shouldn't be needed, but exist
  120. ;; for compatibility with the old OPERS package.  The old MULSLIS
  121. ;; deleted ones ahead of time.  Is this worth it?
  122.  
  123. (defmfun muln (factors simp-flag)
  124.   (cond ((null factors) 1)
  125.     ((atom factors) factors)
  126.     (t (simplifya `((mtimes) . ,factors) simp-flag))))
  127.  
  128. (defmfun div (x y) (if (=1 x) (inv y) (mul x (inv y))))
  129.  
  130. (defmfun div* (x y) (if (=1 x) (inv* y) (mul (simplifya x nil) (inv* y))))
  131.  
  132. (defmfun ncmul2 (x y) (simplifya `((mnctimes) ,x ,y) t))
  133. (defmfun ncmuln (factors flag) (simplifya `((mnctimes) . ,factors) flag))
  134.  
  135. ;; Exponentiation
  136.  
  137. ;; Don't use BASE as a parameter name since it is special in MacLisp.
  138.  
  139. (defmfun power (*base power)
  140.   (cond ((=1 power) *base)
  141.     (t (simplifya `((mexpt) ,*base ,power) t))))
  142.  
  143. (defmfun power* (*base power)
  144.   (cond ((=1 power) (simplifya *base nil))
  145.     (t (simplifya `((mexpt) ,*base ,power) nil))))
  146.  
  147. (defmfun ncpower (x y)
  148.   (cond ((=0 y) 1)
  149.     ((=1 y) x)
  150.     (t (simplifya `((mncexpt) ,x ,y) t))))
  151.  
  152. ;; [Add something for constructing equations here at some point.]
  153.  
  154. ;; (ROOT X N) takes the Nth root of X.
  155. ;; Warning! Simplifier may give a complex expression back, starting from a
  156. ;; positive (evidently) real expression, viz. sqrt[(sinh-sin) / (sin-sinh)] or
  157. ;; something.
  158.  
  159. (defmfun root (x n)
  160.   (cond ((=0 x) 0)
  161.     ((=1 x) 1)
  162.     (t (simplifya `((mexpt) ,x ((rat) 1 ,n)) t))))
  163.  
  164. ;; (Porm flag expr) is +expr if flag is true, and -expr
  165. ;; otherwise.  Morp is the opposite.  Names stand for "plus or minus"
  166. ;; and vice versa.
  167.  
  168. (defmfun porm (s x) (if s x (neg x)))
  169. (defmfun morp (s x) (if s (neg x) x))
  170.  
  171. ;; On PDP-10s, this is a function so as to save address space.  A one argument
  172. ;; call is shorter than a two argument call, and this function is called
  173. ;; several places.  In Franz, Multics, and the LISPM, this macros out on the
  174. ;; assumption that calls are more expensive than the additional memory.
  175.  
  176. (defmfun simplify (x) (simplifya x nil))
  177.  
  178.